{***************************************************************
    SpyGestion  Copyright (C) 2008 Christophe KOALI <nature2gas@gmail.com>
    
    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.
    
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
    
    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
    
****************************************************************}
unit modClassElements;

interface

uses Classes, SysUtils, //modCore,
     ESBDates,
     modBaseType,
     modUnitAndDefInfos,
     sFonctionsChaines;


type
     TListElements = class(TList)
     private
         // Debug
         FDebugProc: TsfcProcStatus;


         // IO
         function LoadLigneItem(Ligne: string): TOGItemCost;

         // Debug
         procedure DoDebug(const Msg: string);
     public
     
         // Suppression d'un type, en vue de le mettre à jour
         function DeleteThisType(GIDType: TTypeGID): integer;


         // Pour un GID donnée, la fonction retourne le niveau
         function GetNiveauOfThisGID(Gid: integer): integer;


         // Pour un GID donnée, la fonction indique si il est en construction ou pas
         function GetIfThisGIDIsInConstruction(Gid: integer): boolean;


         // Définit si un élément du type voulu est en construction
         // et par conséquent empêche la construction d'un élément du même type
         // La fonction N'indique PAS si un élément est constructible
         function SomethingOfThisTypeIsInConstruction(TypeGID: TTypeGID): boolean;

         
         // Calcul le score des elements de defenses
         function CalculScoreDefense(uInfos: TCollectionUnitInfos): integer;


         // Manipulation des pointeurs
         function GetGidItem(Gid: integer): POGItemCost;
         function Ajout(Element: TOGItemCost): POGItemCost;
         procedure Delete(Index: integer);

         // vide la liste en supprimant les pointeurs
         procedure ClearAndDispose;


         // Debug
         property DebugProc : TsfcProcStatus read FDebugProc write FDebugProc;
         procedure SendToDebugAllInfo;

         // Constructeur et trie
         constructor Create;
         procedure Trie;

         // Input output
         procedure SaveToFile(var F: TextFile);
         function LoadFromFile(var F: TextFile; NbElements: integer): integer;
     end;


implementation

function ComparePOGItemCost_By_GID(Item1, Item2: Pointer): integer;
var e1, e2: POGItemCost;
begin

    // Compare renvoie < 0 si Item1 est inférieur à Item2,
    //                   0 s'ils sont égaux
    //                 > 0 si Item1 est supérieur à Item2
    // Voir http://alphomega.developpez.com/TriTList/
    // pour savoir comment trier sur plusieurs critére

    e1 := Item1;
    e2 := Item2;

    // Ici on ne compare que deux entiers, donc:
    if e1.GID < e2.GID then
       // Item1 est inférieur à Item2
       Result := -1

    else if e1.GID = e2.GID then
       // Egalité
       Result := 0

    else
       // Sinon Item1 est supérieur à Item2
       Result := 1;
end;

procedure TListElements.Trie;
begin
    Sort(ComparePOGItemCost_By_GID);
end;


procedure TListElements.ClearAndDispose;
var i: integer;
begin

    if Count =  0 then exit;
    
    for i := Count - 1 downto 0 do begin
        Delete(i);
    end;

    inherited Clear;
end;


procedure TListElements.Delete(Index: integer);
var e: POGItemCost;
begin

   if (Index < 0) or (Index >= Count) then
      exit;

   e := Items[Index];

   Dispose(e);

   inherited Delete(Index);


end;

constructor TListElements.Create;
begin
    inherited Create;
    
    FDebugProc := nil;
end;

function TListElements.GetGidItem(Gid: integer): POGItemCost;
var i: integer;
begin

    if Count = 0 then begin
       Result := nil;
       exit;
    end;

    for i := Count - 1 downto 0 do begin
        Result := Items[i];

        if Result.GID = Gid then begin
           // Trouvé
           exit;
        end;

    end;

    // Non trouvé
    Result := nil;

end;


function TListElements.CalculScoreDefense(uInfos: TCollectionUnitInfos): integer;
var i: integer;
    e: POGItemCost;
    pui: PUnitInfos;
begin

    Result := 0;
    if Count = 0 then exit;

    for i := 0 to Count - 1 do begin
       e := Items[i];

       if e.GIDType = tgidDefense then begin

          pui := uInfos.Get_Pointeur(e.GID);

          if (pui <> nil) and (pui.ScoreDef <> 0) then begin
             Result := Result + (pui.ScoreDef * e.Niveau);
          end;

       end;

    end;


end;

function TListElements.SomethingOfThisTypeIsInConstruction(TypeGID: TTypeGID): boolean;
var i: integer;
    e: POGItemCost;
begin
    (*
    CNT_ITEM_DESIGN_BATIMENT  = 1;
    CNT_ITEM_DESIGN_RECHERCHE = 2;
    CNT_ITEM_DESIGN_VAISSEAUX = 3;
    CNT_ITEM_DESIGN_DEFENSE   = 4;
    *)

    Result := false;


    if (TypeGID = tgidVaisseau) or (TypeGID = tgidDefense) then begin
       // pour le chantier spacial, vu que l'on peut tout le temps "construire"
       // (mettre en attente), il y a donc toujours rien qui est en cours
       // de construction (dans le sens que rien n'empêche de lancer un élément
       // de ce type à construire)
       exit;
    end;


    if Count = 0 then begin
       exit;
    end;

    Result := true;

    for i := 0 to Count - 1 do begin
        e := Items[i];

        if e.GIDType = TypeGID then begin
           if e.EnConstruction then begin
              // on ne peut pas
              exit;
           end;
        end;

    end;

    // sinon on peut
    Result := false;

end;


function TListElements.DeleteThisType(GIDType: TTypeGID): integer;
var i: integer;
    e: POGItemCost;
begin
    (*
    CNT_ITEM_DESIGN_BATIMENT  = 1;
    CNT_ITEM_DESIGN_RECHERCHE = 2;
    CNT_ITEM_DESIGN_VAISSEAUX = 3;
    CNT_ITEM_DESIGN_DEFENSE   = 4;
    *)

    Result := 0;
    if Count = 0 then exit;

    for i := Count - 1 downto 0 do begin
        e := Items[i];

        if e.GIDType = GIDType then begin
           // Libére
           Dispose(e);

           // Supprime
           inherited Delete(i);

           Inc(Result);
        end;

    end;

end;

function TListElements.GetIfThisGIDIsInConstruction(Gid: integer): boolean;
var i: integer;
    e: POGItemCost;
begin

    Result := false;
    if Count = 0 then exit;

    for i := Count - 1 downto 0 do begin
        e := Items[i];

        if e.GID = Gid then begin
           Result := e.EnConstruction;
           exit;
        end;
    end;


end;

function TListElements.GetNiveauOfThisGID(Gid: integer): integer;
var i: integer;
    e: POGItemCost;
begin

    Result := -2;
    if Count = 0 then exit;

    for i := Count - 1 downto 0 do begin
        e := Items[i];

        if e.GID = Gid then begin
           Result := e.Niveau;
           exit;
        end;
    end;

end;


procedure TListElements.SendToDebugAllInfo;
var i: integer;
    CurrRes: POGItemCost;
    s, a: string;
begin
    
    if Count = 0 then begin
       DoDebug('Aucun élément');

    end else begin

       for i := 0 to Count - 1 do begin
           CurrRes := Items[i];

          // s := StringOfChar(' ', 8 - length(s)) + s + ' ';
           s := ESBDGetDureeStrings(CurrRes.Duree, true);

           if CurrRes.EnConstruction then
              a := '***'
           else
              a := '';


           s := format('%3d - %2d %7d %7d %7d - %s %s - %s%s', [CurrRes.GID, CurrRes.Niveau, CurrRes.Prix.Metal, CurrRes.Prix.Cristal, CurrRes.Prix.Deuterium, s, CurrRes.Nom, CurrRes.Link, a]);
           DoDebug(s);
       end;

       DoDebug('');
    end;

end;

procedure TListElements.DoDebug(const Msg: string);
begin
     if Assigned(FDebugProc) then
        FDebugProc(Msg);
        
end;


function TListElements.Ajout(Element: TOGItemCost): POGItemCost;
var pElement: POGItemCost;
begin
   // Result := nil;

    New(pElement);          // Créer l'espace mémoire requis
    pElement^ := Element;   // Fait pointer l'élément

    try
       inherited Add(pElement);  // Ajoute le pointeur à la liste
       Result := pElement;
    except
       Result := nil;
    end;
    
    // Pour libérer la mémoire occupé par l'élément pointer:  Dispose(pElement);

end;

function TListElements.LoadLigneItem(Ligne: string): TOGItemCost;
var i: integer;
begin
    Result.GID             := -1;
    Result.Prix.Metal      :=  0;
    Result.Prix.Cristal    :=  0;
    Result.Prix.Deuterium  :=  0;
    Result.Prix.Energie    :=  0;

    
    Result.Duree           :=  0;
    Result.CanBeBuildIn    := -1;
    Result.CanBeBuildInOpt := -1;

    Result.Link            := '';
    Result.Nom             := '';
    Result.Niveau          := -1;
    Result.EnConstruction  := false;

    Result.GIDType         := tgidAutre;

    if Ligne = '' then exit;
    if Ligne[1] <> 'g' then exit;

    System.Delete(Ligne, 1, 1);

    i := sfcTokenCount(Ligne, ',');
    if i < 7 then exit;

    
    i := Pos('=', Ligne);
    if i = 0 then exit;



    Result.GID := StrToIntDef(copy(Ligne, 1, i - 1), -1);
    if Result.GID = -1 then exit;

    System.Delete(Ligne, 1, i);

    Result.Niveau  := sfcTokenGetInt(Ligne, 1, ',', -1);
    Result.GIDType := GetTypeOfTGID(Result.GID);

    Result.Prix.Metal      := sfcTokenGetInt(Ligne, 3, ',', 0);
    Result.Prix.Cristal    := sfcTokenGetInt(Ligne, 4, ',', 0);
    Result.Prix.Deuterium  := sfcTokenGetInt(Ligne, 5, ',', 0);
    Result.Prix.Energie    := sfcTokenGetInt(Ligne, 6, ',', 0);

    Result.Duree   := sfcTokenGetInt(Ligne, 7, ',', 0);

    i := sfcTokenGetInt(Ligne, 8, ',', 0);
    if i = 0 then
       Result.EnConstruction := false
    else
       Result.EnConstruction := true;

    Result.Nom := sfcTokenGet(Ligne, 9, ',');
       

   // g106=4,2,3200,16000,3200,0,13824,0,Technique espionnage
   
end;

procedure TListElements.SaveToFile(var F: TextFile);
var i, j: integer;
    cE : POGItemCost;
    s: string;
begin

    if Count = 0 then begin
       WriteLn(F, '// Aucun élément connu');
       WriteLn(F, '');
       exit;
    end;

    WriteLn(F, format('g=%d', [Count]));

    for i := 0 to Count - 1 do begin
       cE := Items[i];

       s := format('g%d=%d,%d,', [cE.GID, cE.Niveau, 0]);
       s := s + format('%d,%d,%d,%d,', [cE.Prix.Metal, cE.Prix.Cristal, cE.Prix.Deuterium, cE.Prix.Energie]);

       j := iif(cE.EnConstruction, 1, 0);

       s := s + format('%d,%d', [cE.Duree, j]);


       if cE.Nom <> '' then
          s := s + ',' + cE.Nom;

       WriteLn(F, s);
    end;

    WriteLn(F, '');

end;

function TListElements.LoadFromFile(var F: TextFile; NbElements: integer): integer;
var Ligne: string;
    cE: TOGItemCost;
    i: integer;
begin

    Result := 0;
    i := 0;

    While NoT(EoF(F)) do begin
       ReadLn(F, Ligne);

       Ligne := trim(Ligne);
       if Ligne = '' then break;
       if Ligne[1] = '#' then Continue;
       if Ligne[1] = '/' then Continue;

       cE := LoadLigneItem(Ligne);

       if cE.GID > 0 then begin
          Ajout(cE);
          Inc(Result);
       end else if i > 0 then
          break;

       Inc(i);
    end;

    
   // LoadLigneItem(Ligne: string): TOGItemCost;
end;


end.
